with Ada.Exceptions;
with Ada.Unchecked_Conversion;
with System;                     use System;
with Interfaces.C;               use Interfaces.C;

with Win32;                      use Win32;
with Win32.Winuser;

package body win32api_interface.process is

  ------------------
  -- Close_Handle --
  ------------------

  procedure Close_Handle (Obj : Win32.Winnt.HANDLE) is
  begin
    if Win32.Winbase.CloseHandle (Obj) /= Win32.True then
      Report_Error_Thr("CloseHandle", Get_Last_Error);
    end if;
  end Close_Handle;

  --------------
  -- lstrlenW --
  --------------

  function lstrlenW (lpString : in Object_Name_Record) return Natural is
  begin
    return Natural(Win32.Winbase.lstrlenW(Win32.PCWCH(lpString.Buffer)));
  end lstrlenW;

  --------------------
  -- Create_Process --
  --------------------

  function Create_Process(Path : in String; Directory : in String) return Process_ID is
    LaunchOk: Win32.BOOL;

   function To_LPSTR is new
     Ada.Unchecked_Conversion
     (System.Address,
      Win32.LPSTR);

   function To_PCCH is new
     Ada.Unchecked_Conversion
     (System.Address,
      Win32.PCCH);

    Command_Line      : Interfaces.C.Char_Array
      := Interfaces.C.To_C(Path & ascii.nul);
    Current_Directory : Interfaces.C.Char_Array
      := Interfaces.C.To_C(Directory & ascii.nul);
    Startup_Info      : aliased Win32.Winbase.STARTUPINFO;
    Process_Info      : aliased Win32.Winbase.PROCESS_INFORMATION;
  begin
    Startup_Info.cb
      := (Win32.Winbase.STARTUPINFOA'Size)/System.Storage_Unit;
    Startup_Info.lpReserved  :=   null;
    Startup_Info.lpDesktop   :=   null;
    Startup_Info.lpTitle     :=   null;
    Startup_Info.dwFlags     :=   0;
    Startup_Info.cbReserved2 :=   0;
    Startup_Info.lpReserved2 :=   null;

    LaunchOk := Win32.Winbase.CreateProcess(
                  lpApplicationName     =>   null,
                  lpCommandLine         =>   To_LPSTR(Command_Line'Address),
                  lpProcessAttributes   =>   null,
                  lpThreadAttributes    =>   null,
                  bInheritHandles       =>   Win32.False,
                  dwCreationFlags       =>   0,
                  lpEnvironment         =>   System.Null_Address,
                  lpCurrentDirectory    =>   To_PCCH(Current_Directory'Address),
                  lpStartupInfo         =>   Startup_Info'Unchecked_Access,
                  lpProcessInformation  =>   Process_Info'Unchecked_Access );
    if integer(LaunchOK) = 0 then
      Report_Error_Thr("Launch_Process", Get_Last_Error);
    end if;
    return Process_Info.dwProcessId;
  end Create_Process;

  ------------------
  -- Open_Process --
  ------------------

  function Open_Process(ProcID : in Process_ID) return Win32.Winnt.HANDLE is
    AccessHandle: Win32.Winnt.HANDLE;
  begin
    AccessHandle := Win32.Winbase.OpenProcess(
                      Win32.Winnt.PROCESS_ALL_ACCESS,
                      Win32.FALSE,
                      ProcID);
    if Address_equals(AccessHandle, System.Null_Address)
      then Report_Error_Thr("OpenProcess", Get_Last_Error);
    end if;
    return AccessHandle;
  end Open_Process;

  ------------------------
  -- Open_Process_Query --
  ------------------------

  function Open_Process_Query(ProcID : in Process_ID) return Win32.Winnt.HANDLE is
    AccessHandle: Win32.Winnt.HANDLE;
  begin
    AccessHandle :=
      Win32.Winbase.OpenProcess(Win32.Winnt.PROCESS_QUERY_INFORMATION or
                                  Win32.Winnt.PROCESS_VM_READ,
                                Win32.FALSE, ProcID);
    --if Address_equals(AccessHandle, System.Null_Address) then
      --Put_Line("Failed "&Win32.DWORD'Image(Get_Last_Error));
      --Report_Error_Thr("Open_Process_Query", Get_Last_Error);

    --end if;
    return AccessHandle;
    --  Note that the Handle validity is not checked as sometimes this function
    --  is used in getting the process names, and when enumerating them, a
    --  Handle to a PID = 0 is requested.
  end Open_Process_Query;

  -----------------------
  -- Terminate_Process --
  -----------------------

  procedure Terminate_Process(AccessHandle : in Win32.Winnt.HANDLE) is
    TerminateOk: Win32.BOOL;
  begin
    TerminateOk := Win32.Winbase.TerminateProcess(
                     hProcess  => AccessHandle,
                     uExitCode => -1);
    if integer(TerminateOK) = 0 then
      Report_Error_Thr("TerminateProcess", Get_Last_Error);
    end if;
  end Terminate_Process;

  ------------------------
  -- Get_System_Handles --
  ------------------------

  type NtQuerySystemInformation_Access is access function
    (Class : Win32.DWORD;
     Information : Win32.PVOID;
     Length : Win32.ULONG;
     ReturnLength : Win32.PULONG)
    return Win32.LONG;
  pragma Convention (Stdcall, NtQuerySystemInformation_Access);

  function Convert is new Ada.Unchecked_Conversion
    (Win32.Windef.FARPROC, NtQuerySystemInformation_Access);
  NtQuerySystemInformation : NtQuerySystemInformation_Access
    := Convert (Win32.Winbase.GetProcAddress(
                  Ntdll_Handle, Win32.Addr(
                                  "NtQuerySystemInformation"&ascii.nul)));
  SystemHandleInformation : constant := 16;

  function Unsigned_Convert is new Ada.Unchecked_Conversion
    (Win32.ULONG, Win32.LONG);
  STATUS_INFO_LENGTH_MISMATCH : constant Win32.LONG
    := Unsigned_Convert (16#C0000004#);

  function Get_System_Handles return System_Handle_Array is
    type System_Handle_Table (Entries : Win32.ULONG) is record
      Handles : System_Handle_Array (1 .. Entries);
    end record;
    pragma Convention (C, System_Handle_Table);
    type System_Handle_Table_Access is access all System_Handle_Table;
    function Convert is new Ada.Unchecked_Conversion
      (Win32.LPVOID, System_Handle_Table_Access);

    Target_Handle : Win32.LPVOID := System.Null_Address;
    Size          : ULong := 16#20000#;
    Result        : Win32.LONG;
  begin
    --  We use the undocumented NtQuerySystemInformation call to copy the
    --  system handle table.  We have to increase the target table size
    --  until all data fits into it.
    loop
      if Target_Handle /= System.Null_Address then
        if Win32.Winbase.VirtualFree(Target_Handle, 0, Win32.Winnt.MEM_RELEASE)
          = Win32.FALSE
        then
          Report_Error_Thr("Get_System_Handles (VirtualFree)", Get_Last_Error);
        end if;
      end if;
      Target_Handle := Win32.Winbase.VirtualAlloc(System.Null_Address, Size,
                                                  Win32.Winnt.MEM_COMMIT,
                                                  Win32.Winnt.PAGE_READWRITE);
      if Target_Handle = System.Null_Address then
         Report_Error_Thr("Get_System_Handles (VirtualAlloc)", Get_Last_Error);
      end if;
      Result := NtQuerySystemInformation (SystemHandleInformation,
                                          Target_Handle, Size, null);
      if Result = STATUS_INFO_LENGTH_MISMATCH then
        Size := Size * 2;
      elsif Result < 0 then
        Report_Error_Thr("Get_System_Handles (NtQuerySystemInformation)", Get_Last_Error);
      else
        exit;
      end if;
    end loop;
     --  Now return a temporary copy of the table.
    declare
      Result : constant System_Handle_Array := Convert (Target_Handle).Handles;
    begin
      if Win32.Winbase.VirtualFree(Target_Handle, 0,
                                   Win32.Winnt.MEM_RELEASE) = Win32.FALSE
      then
        Report_Error_Thr("Get_System_Handles (VirtualFree)", Get_Last_Error);
      end if;
      return Result;
    end;
  end Get_System_Handles;

  -----------------
  -- Find_Window --
  -----------------

  function Find_Window (Name : in String) return Win32.Winnt.HANDLE is
    WinHandle : Win32.Winnt.HANDLE;
  begin
    WinHandle := Win32.Winuser.FindWindow(
                   Null,
                   Win32.Addr(Name&ascii.nul));
    if WinHandle = System.Null_Address
      then Report_Error_Thr("FindWindow", Get_Last_Error);
      else Return WinHandle;
    end if;
  end Find_Window;

  ----------------------------------
  -- Get_Window_Thread_Process_ID --
  ----------------------------------

  function Get_Window_Thread_Process_ID (Handle : in Win32.Winnt.HANDLE)
    return Process_ID is
    ThreadHandle: Win32.DWORD;

    type tProcessID is new Win32.DWORD;
    type pProcessID is access all tProcessID;
    ProcID: aliased tProcessID;
    pProcID: constant pProcessID:= ProcID'access;
    function pProcID_to_Address is new
      Ada.Unchecked_Conversion
        (source => pProcessID,
         target => Win32.PULONG);
  begin
    ThreadHandle := Win32.Winuser.GetWindowThreadProcessId(
                      Handle,
                      pProcID_to_Address(pProcID));
    return Interfaces.C.unsigned_long(ProcID);
  end Get_Window_Thread_Process_ID;

  -------------------
  -- GetWindowText --
  -------------------

  function GetParent
    (hwnd : Win32.Windef.HWND) return Win32.Windef.HWND;
  pragma Import (StdCall, GetParent, "GetParent");

  -------------------
  -- GetWindowText --
  -------------------

  function GetWindowText
    (hwnd : Win32.Windef.HWND;
     Text : Win32.LPSTR; --System.Address; --
     Max  : Win32.INT) return Win32.INT;
  pragma Import (StdCall, GetWindowText, "GetWindowTextA");

  --------------
  -- EnumProc --
  --------------

  i : integer := 0;
  function EnumProc (hwnd   : Win32.Windef.HWND;
                     lParam : Win32.LPARAM) return Win32.Bool is
    nb :  Win32.INT := 0;
    buffer : Win32.Char_Array(1..200);
    title : Win32.Char_Array(1..200);
  begin
    nb := Win32.WinUser.GetClassName (hwnd,
                                      Win32.Addr(buffer),
                                      buffer'Length);
    nb := GetWindowText(hwnd, Win32.Addr(title), 100);
    if nb /= 0 and Win32.Winuser.IsWindowVisible(HWND) = Win32.TRUE then
      i := i+1;
      ----?
    end if;
    return Win32.TRUE;
  end EnumProc;

  --------------------------------
  -- Create_Toolhelp32_Snapshot --
  --------------------------------

  function CreateToolhelp32Snapshot
    (dwFlags       : DWORD;
     th32ProcessID : DWORD)
     return Win32.Winnt.HANDLE;
  pragma Import (Stdcall, CreateToolhelp32Snapshot, "CreateToolhelp32Snapshot");
  function Create_Toolhelp32_Snapshot(Proc : in Process_ID;
                                      Flag : Win32.DWORD) return HANDLE is
    H :  Handle;
  begin
    H := CreateToolhelp32Snapshot(Flag, Proc);
    if H = Win32.Winbase.INVALID_HANDLE_VALUE then
      Report_Error_Thr("CreateToolhelp32Snapshot", Get_Last_Error);
    else return H; end if;
  end Create_Toolhelp32_Snapshot;

  -------------------
  -- Module32First --
  -------------------

  function Module32First
    (hSnapshot : HANDLE;
     lpme      : PMODULEENTRY32)
     return Win32.BOOL;
  pragma Import (Stdcall, Module32First, "Module32First");
  function Module32_First
    (H : in Handle)
     return MODULEENTRY32 is
    B      : Win32.BOOL;
    mEntry : aliased MODULEENTRY32;
  begin
    mEntry.dwSize := MODULEENTRY32'Size;
    B := Module32First(H, mEntry'Unrestricted_Access);
    if B = 0 then Report_Error_Thr("Module32First", Get_Last_Error);
    else return mEntry; end if;
  end Module32_First;

  ------------------
  -- Module32Next --
  ------------------

  function Module32Next
    (hSnapshot : HANDLE;
     lpme      : PMODULEENTRY32)
     return Win32.BOOL;
  pragma Import (Stdcall, Module32Next, "Module32Next");
  function Module32_Next
    (H : in Handle)
     return MODULEENTRY32 is
    B      : Win32.BOOL;
    mEntry : aliased MODULEENTRY32;
  begin
    mEntry.dwSize := MODULEENTRY32'Size;
    B := Module32Next(H, mEntry'Unrestricted_Access);
    if B = 0 then Report_Error_Thr("Module32Next", Get_Last_Error);
    else return mEntry; end if;
  end Module32_Next;

begin
  --  Ensure that all GetProcAddress invocations were successful.
  if PSAPI_Handle = System.Null_Address then
    Ada.Exceptions.Raise_Exception(Win32_Error'Identity,
      "PSAPI.DLL not found.  On Windows NT, you have to"
      & "install it manually from the Platform SDK.");
  end if;
  if EnumProcesses = null then
    Report_Error_Thr("GetProcAddress (Enumprocesses)", Get_Last_Error);
  end if;
  if EnumProcessModules = null then
    Report_Error_Thr("GetProcAddress (EnumProcessModules)", Get_Last_Error);
  end if;
  if GetModuleBaseName = null then
    Report_Error_Thr("GetProcAddress (GetModuleBaseName)", Get_Last_Error);
  end if;
  if NtQuerySystemInformation = null then
    Report_Error_Thr("GetProcAddress (NtQuerySystemInformation)", Get_Last_Error);
  end if;
  if NtQueryObject = null then
    Report_Error_Thr("GetProcAddress (NtQueryObject)", Get_Last_Error);
  end if;
end win32api_interface.process;
